COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	make smaller images from big images
C00004 00003	BEGIN "SCAN_A"
C00009 ENDMK
C⊗;
comment make smaller images from big images;
BEGIN "PICW"

REQUIRE "ABBREV.1D[S1,TOB]" SOURCE_FILE;
REQUIRE "STD.12H[S1,TOB]" SOURCE_FILE;
REQUIRE "STD[S1,TOB]" LOAD_MODULE;



REQUIRE "WINDOW.11I[S1,TOB]" SOURCE_FILE;
REQUIRE "WINDF.10E[S1,TOB]" SOURCE_FILE;
REQUIRE "WINDF[S1,TOB]" LOAD_MODULE;

REQUIRE "PIC.11E[S1,TOB]" SOURCE_FILE;
REQUIRE "PIC[S1,TOB]" LOAD_MODULE;

REQUIRE "SPACE.3H[S1,TOB]" SOURCE_FILE;
REQUIRE "SPACE[S1,TOB]" LOAD_MODULE;
REQUIRE "SPACEA[S1,TOB]" LOAD_MODULE;

REQUIRE "VARIAB.3I[S1,TOB]" SOURCE_FILE;
STRING FILE_NAME;
WINDOW_PTR W;

CREATE_W(W);
FILE_NAME←ASK_STRING(CRLF&"INPUT FILE NAME ");
ASK_PIX(W,"PIC,HE",FILE_NAME&".SU");
ASK_WINDOW(W);
READ_PIX(W);
FILE_NAME←ASK_STRING(CRLF&"OUTPUT FILE NAME? ");
FILE_NAME←FILE_NAME&".SM[PIC,HE]";
OUT_W(W,FILE_NAME);  comment write out a window;
END "PICW";
BEGIN "SCAN_A"
  INTEGER CHANNEL;
  INTEGER COUNT_EDGE;
  INTEGER ARRAY DISK_BLOCK[1:'200];  comment one record;

  INTERNAL PROCEDURE ASK_E;
  WHILE YES("CHANGE EDGE VALUES? ") DO BEGIN "ASK_E"
    MODIFY(NOISE_EDGE);
    DIFF_FRACTION←1.35;
    DIFF←DIFF_FRACTION*(NOISE_EDGE↑2);
    END "ASK_E";

  PROCEDURE WRITE_EDGE;
  BEGIN "WR_EDGE"
  REAL C;  COMMENT CONTRAST;
    REAL PHI; COMMENT ANGLE;
    WORDOUT(CHANNEL,OPX);
    WORDOUT(CHANNEL,OPY);
    PHI←ATAN2(CY,CX);
    WORDOUT(CHANNEL,PHI);
    C←TM+TP;
    WORDOUT(CHANNEL,C);
    COUNT_EDGE←COUNT_EDGE+1;
    END "WR_EDGE";

  PROCEDURE PRINT_OP(SHORT INTEGER X,Y;STRING S);
  BEGIN
    TCRLF;WRITE(X);WRITE(Y);
    WRITE(OPX);WRITE(OPY);
    WRITE(CX);WRITE(CY);
    OUTSTR(CRLF&"	");
    WRITE(OPXM);WRITE(OPYM);WRITE(OPXP);WRITE(OPYP);
    OUTSTR(CRLF&"	");
    WRITE(TM);WRITE(TP);
    WRITE(B);
    OUTSTR(CRLF&"	");
    WRITE(S0SQ);WRITE(N0SQ);
    TCRLF;
    END;

INTERNAL BOOLEAN PROCEDURE APPLY_OP(SHORT INTEGER X,Y,FLAG);
  BEGIN "APPLY"
  BOOLEAN F;
  SHORT REAL V;
  IF FLAG THEN BEGIN TCRLF;WRITE(X);WRITE(Y);END;
  IF F←EJLI(X,Y,0,0)∧¬BCOMP THEN PRINT_OP(X,Y," ");
  IF BCOMP THEN BEGIN 
       WRITE(BCOMP); PRINT_OP(X,Y," ");END;
    IF OPOOB THEN WRITE(OPOOB);
  IF ¬F AND FLAG THEN BEGIN "FAIL"
    IF WEAK THEN WRITE(WEAK);
    IF NOISY THEN WRITE(NOISY);
    IF NEARED THEN WRITE(NEARED);
    END "FAIL";
  RETURN (F);
  END "APPLY";

  INTERNAL PROCEDURE INIT_OP(WINDOW_PTR W;INTEGER BL;
    REFERENCE INTEGER X1,Y1,X2,Y2);
    BEGIN
    INTEGER R_OP; ! radius of operator;
    CONF←.85;
    BITS←BITS_W(W);
    LSIDE←X1W_W(W);FLINE←Y1W_W(W);RSIDE←X2W_W(W);LLINE←Y2W_W(W);
    LINLEN←LINLB_W(W);
    IWID←RSIDE-LSIDE+1;
    TVWORD←XWD(-SIZEB_W(W),LOCB_W(W,BL)-1);
    WRITE(BITS);WRITE(LINLEN);WRITE(IWID);WRITE(SIZEB_W(W));
    WRITE(LOCB_W(W,BL));
    EJINIT;
    R_OP←CIRCLE+2.0;
    X1←LSIDE+R_OP;
    X2←RSIDE-R_OP;
    Y1←FLINE+R_OP;
    Y2←LLINE-R_OP;
    END;

  PROCEDURE TRY_OP(INTEGER X,Y);
    IF EJLI(X,Y,0,0) THEN BEGIN "STORE"
      INTEGER XR,YR;
      XR←OPX+0.5;YR←OPY+0.5; ! find the edge center;
      IF EJLI(XR,YR,0,0) THEN WRITE_EDGE; ! write edges in a file;
      END "STORE";

  ASK_E;

  OPEN_OUT(CHANNEL←GETCHAN,BINARY_FILE,FILE_NAME&".EDG[DAT,TOB]");
    comment write out file named .EDG;
  ARRYOUT(CHANNEL,DISK_BLOCK[1],'200);

  BEGIN "RSCAN" comment raster scan, writing out edges in a file;
    INTEGER Y1,Y2,X1,X2,X,Y;
    Y1←Y1W_W(W);Y2←Y2W_W(W); X1←X1W_W(W);X2←X2W_W(W);
    WRITE(X1);WRITE(X2);WRITE(Y1);WRITE(Y2);
    INIT_OP(W,RED_W,X1,Y1,X2,Y2); ! init edge operator;
    FOR Y←Y1 STEP 2 UNTIL Y2 DO
      FOR X←X1+(Y%2) MOD 2 STEP 2 UNTIL X2 DO TRY_OP(X,Y);
    DISK_BLOCK[1]←CVSIX("EDGE");
    DISK_BLOCK[2]←COUNT_EDGE;
    DISK_BLOCK[3]←X1;
    DISK_BLOCK[4]←X2;
    DISK_BLOCK[5]←Y1;
    DISK_BLOCK[6]←Y2;
    END "RSCAN";
  USETO(CHANNEL,1);
  ARRYOUT(CHANNEL,DISK_BLOCK[1],'200);
  CLOSE(CHANNEL);
  END "SCAN_A";
END;